Otherware/Otherware_1_SB_Development.iso/mac/hypercar/xfcn/spttool.cpt/Support Tools eXternals 1.2.5/card_38961.txt

Text File | 1990-11-13 | 12KB | 360 lines

-- card: 38961 from stack: in.5
-- bmap block id: 44053
-- flags: 0000
-- background id: 3858
-- name: OpenFiles
----- HyperTalk script -----
on CloseCard
  put empty into cd fld "file list"
  set the scroll of cd fld "file list" to 0
  pass CloseCard
end CloseCard

on HideObjects
  hide cd fld "file list"
  hide cd btn "try it!"
end HideObjects

on ShowObjects
  show cd fld "file list"
  show cd btn "try it!"
end ShowObjects


-- part 1 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=82 top=292 right=326 bottom=175
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 8192
-- line height: 16
-- part name: Try It!
----- HyperTalk script -----
on mouseUp
  global errGlobal
  put volumePath() into newVolume
  if newVolume = empty then exit mouseUp
  put OpenFiles(newVolume, "noDialog:errGlobal") into fileList
  if errGlobal Γëá empty then
    answer "Error:" && errGlobal
    put empty into errGlobal
  else
    put fileList into cd fld "file list"
  end if
end mouseUp




-- part 2 (field)
-- low flags: 00
-- high flags: 0007
-- rect: left=3 top=117 right=288 bottom=256
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 4
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: file list


-- part contents for background part 38
----- text -----
34/50

-- part contents for background part 20
----- text -----
     An XFCN which returns a list of  all open files on a specified volume.  Files are listed as full-path-names.

     Calling syntax : OpenFiles(volName, <ΓÇ£noDialogΓÇ¥:errorGlobal>)
  VOLNAME: the volume to check.

NOTE:  Sometimes you will see the same file listed twice.  This is usually caused by the data and resource forks being open simultaneously.

-- part contents for background part 42
----- text -----
{ OpenFiles(volumeName)                    }
{ XFCN returns a list of the open files on the specified     }
{volume.  Get the list by stepping through the FCBs.    }
{}
{  brought to you by:  Anup Murarka      Eric Carlson    }
{            ALINK:  SKEPTIC      ALINK:  cyNic  }
{                  CIS:  76004,3356    }
{}
{        We are part of the Support Tools Development Group,  }
{        Apple Computer, Inc.   }
{}
{        please DO NOT contack Mac DTS for support of this code!  }
{}
{        please DO contact the authors for support of this code!  }
{}
{        Send comments, bug reports, requests to any of the above  }
{        E-mail addresses or to:}
{}
{              (one of us)          }
{              Apple Computer, Inc.     }
{              900 E. Hamilton, Ave.    }
{              Campbell, CA   95008    }
{              M/S 72-L          }
{}
{  Copyright:  © 1989, 1990 by Apple Computer, Inc., all rights reserved.  }
{}
{ written by Eric Carlson                    }
{ AppleLink:  cyNic                        }
{ modification history                      }
{       Date        Initials                  Comments              }
{       ----        ------  ------------------------------------------------------}
{    1/7/90      ec       first written                            }
{    8/28/90      ec      added additional error checking when extending handle, changed}
{                    structure of loop.  changed version to 1.1  }
{}

unit OpenFiles;

interface

  uses
    HyperXCMD;

  procedure MAIN (paramPtr: XCmdPtr);

implementation

  function AppendString (h: Handle;
                  newStr: Str255): OSErr;
  { stick the string onto the back of the handle }
  begin
    AppendString := PtrAndHand(Ptr(ORD4(@newStr) + 1), h, LENGTH(newStr));
  end;

  procedure reportToUser (paramPtr: XCmdPtr;
                  msgStr: str255);
{}
{ report something back to the user.  }
{ the last parameter (optional) to an external may contain }
 { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
 { of a HyperTalk global variable into which error messages will be }
 { placed.  we've decided to use this approach to avoid confusing }
{ an error message with a valid result being returned from an XFCN. }
{}
    var
      tempStr: str255;
  begin
{check the last param to see if the user requested that}
{ we suppress the error dialog }
    ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
    UprString(tempStr, true);
    if pos('NODIALOG', tempStr) = 0 then
  { no special error handling specified, throw up a dialog and return the error message }
      begin
        SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
        paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
      end
    else if (pos(':', tempStr) > 0) then
  { requested global AND noDialog so we fill in the global and return empty }
      begin
        tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
                            { get the name of the HC global  to fill }
        SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
                            { and fill it }
        paramPtr^.returnValue := PasToZero(paramPtr, '');  { return empty }
      end
    else
  { requested noDialog only so we return the error condition as the result }
      paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  end;  { procedure }

  function askedForHelp (paramPtr: XCmdPtr;
                  syntaxMsg: Str255;
                  copyRightMsg: Str255): boolean;
{  check to see if the user sent a '?' or a '!' as }
{ the only parameter. if so we will respond with }
{ the calling syntax or the copyright/version info }
{ for this external }
{}
    var
      firstStr: str255;
  begin
    askedForHelp := false;
    if paramPtr^.paramCount = 1 then
      begin
        ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
          { what is the first param? }
        if firstStr = '?' then
          begin
            reportToUser(paramPtr, syntaxMsg);
            askedForHelp := true
          end  { asked for help }
        else if firstStr = '!' then
          begin
            reportToUser(paramPtr, copyRightMsg);
            askedForHelp := true
          end;  { asked for copyright info }
      end;  { one parameter passed }
  end;    { function }

  function getVolRefNum (pathName: str255): integer;
  { function to return the volume reference number of the volume specified in the pathName}
  { parameter.  Will automatically strip any trailing directory/file names, or add a colon to }
  { the volume name.  MaxInt is returned if an error is encountered. }
    var
      paramBlock: HParamBlockRec;
      errorCode: OSerr;
  begin
{ a path name must have a colon on the end }
    pathName := concat(pathName, ':');
    pathName := copy(pathName, 1, pos(':', pathName));
    with paramBlock do
      begin
        ioCompletion := nil;
        ioNamePtr := @pathName;
        ioVRefNum := 0;
        ioVolIndex := -1;
    { if volindex is zero the file manager will try to get to the volume}
    { through the ioVRefNum ΓÇö not a good thing here as that is what we don't know! }
      end;
    errorCode := PBHGetVInfo(@paramBlock, FALSE);
    if errorCode <> noErr then
      getVolRefNum := maxInt
    else
      getVolRefNum := paramBlock.ioVRefNum;
  end;

  function BitTest (AddressToCheck: ptr;
                  TotalBits: integer;
                  BitToTest: longint): boolean;
  { function that allows caller to use std. 68000 bit notation instead of the Toolbox's reversed notation}
  { example:  bit 0 (the least significant bit) in a byte is bit 7 in the Toolbox's notation}
  begin
    BitTest := BitTst(AddressToCheck, TotalBits - 1 - BitToTest);
  end;

  function AUXisRunning: boolean;
    const
      HWCfgFlag = $0B22;
  begin
    AUXisRunning := BitTest(pointer(HWCfgFlag), 16, 9);
  end;

  function PathNameFromDirID (dirID: longint;
                  vRefnum: integer;
                  var fullPathName: str255): OSErr;
{ build up a full path name given a directory id and an vol ref num.  this method isn't reccomended in general (see the }
{  various tech notes, but we use it in HC externals as HC uses exclusively full path names }
    var
      myCPB: CInfoPBRec;
      directoryName: str255;
      err: OSErr;
  begin
    fullPathName := '';
    with myCPB do
      begin
        ioNamePtr := @directoryName;
        ioDrParID := DirId;
      end;

    repeat
      with myCPB do
        begin
          ioVRefNum := vRefNum;
          ioFDirIndex := -1;
          ioDrDirID := myCPB.ioDrParID;
        end;
      err := PBGetCatInfo(@myCPB, FALSE);

      directoryName := concat(directoryName, ':');

{ pascal strings mustn't be longer than 255 chars, though a path name may, so check }
      if length(directoryName) + length(fullPathName) <= 255 then
        fullPathName := concat(directoryName, fullPathName)
      else
        myCPB.ioDrDirID := fsRtDirID;    { lazy persons way to jump out }

    until (myCPB.ioDrDirID = 2);
    PathNameFromDirID := err;
  end;

  procedure OpenFiles (paramPtr: XCmdPtr);
    var
      FP: FCBPBRec;
      volRefNum, fileNdx: integer;
      requestedVolName, fileName, filePath: str255;
      fileErr, err: OSErr;
      fileList: handle;
  begin
    if askedForHelp(paramPtr, 'OpenFiles(volumeName,<“noDialog”:errorGlobal>)', 'v1.0, © 1990  Apple Computer, Inc., Eric Carlson') then
      exit(OpenFiles);

    if paramPtr^.paramCount < 1 then          { we need the disk name to search for }
      begin
        reportToUser(paramPtr, 'Disk name expected');
        exit(OpenFiles)
      end;
    ZeroToPas(paramPtr, paramPtr^.params[1]^, requestedVolName);

    volRefNum := GetVolRefNum(requestedVolName);    { get the vol ref num }
    if volRefNum = maxInt then
      begin
        ReportToUser(paramPtr, 'Volume not found.');
        exit(OpenFiles);
      end;

    fileList := NewHandle(0);          { allocate a handle for the file list }
    err := MemError;
    if err <> noErr then
      begin
        reportToUser(paramPtr, 'Out of memory.');
        if fileList <> nil then
          DisposHandle(fileList);
        exit(OpenFiles);
      end;

    zeroBytes(paramPtr, @FP, sizeOf(FP));
    FP.ioCompletion := nil;              { don't want async }
    FP.ioVRefNum := volRefNum;          { only files on the specified volume }
    FP.ioNamePtr := @fileName;          { the file name }
    FP.ioFCBIndx := 0;                { start with the first file }
    repeat                      { loop through all files}
      FP.ioFCBIndx := FP.ioFCBIndx + 1;      { go to the next file }
      fileErr := PBGetFCBInfo(@FP, false);    { check the next file }
      if fileErr = noErr then
        fileErr := PathNameFromDirID(FP.ioFCBParID, FP.ioVRefNum, filePath);  { build the path }
      if fileErr = noErr then
        begin
          filePath := concat(filePath, fileName, chr(13));    { add the file name, CR }
          err := AppendString(fileList, filePath);          { remember the file name }
          if err <> noErr then
            begin
              reportToUser(paramPtr, 'Out of memory.');
              if fileList <> nil then
                DisposHandle(fileList);
              exit(OpenFiles);
            end;
        end;
    until (fileErr <> noErr);
    if fileList <> nil then
      begin
        SetHandleSize(fileList, GetHandleSize(fileList) - 1);  { drop the trailing CR }
        fileErr := AppendString(fileList, chr(0));        { Terminate with 0 byte  }
        if fileErr <> noErr then
          begin
            reportToUser(paramPtr, 'Out of memory.');
            if fileList <> nil then
              DisposHandle(fileList);
          end;
        paramPtr^.returnValue := fileList;
      end;
  end;

  procedure MAIN (paramPtr: XCmdPtr);
  begin
    OpenFiles(paramPtr);
  end;

end.  { unit OpenFiles}